home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / netmail / cpt152.zip / CPT-S152.ZIP / CPT_CODE.PAS next >
Pascal/Delphi Source File  |  1996-05-16  |  36KB  |  1,139 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. UNIT CPT_CODE;
  6. INTERFACE
  7.  
  8. {$IFDEF DPMI}
  9.   USES DOS, NUMDAYS, ARCID;
  10. {$ELSE}
  11.   USES DOS, NUMDAYS, ARCID, HEAPMAN;
  12. {$ENDIF}
  13.  
  14. TYPE
  15.   MemLink = ^MemberRec;
  16.   MemberRec = RECORD
  17.                 Name   : STRING [25];
  18.                 sent   : WORD;
  19.                 oldest,
  20.                 newest : STRING [8];
  21.                 BBS1,
  22.                 BBS2   : STRING [79];
  23.                 notes  : STRING [79];
  24.                 next   : MemLink;
  25.               END;
  26.  
  27. CONST
  28.   version = ' v1.52 ';
  29.   author  = 'Copyright (c) May 16th, 1996, by David Daniel Anderson - Reign Ware.';
  30.  
  31.   OldDelimitLine = '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=' +
  32.                    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=';
  33.  
  34.   DelimitLine = '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' +
  35.                 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~';
  36.  
  37.   EndOfDB = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>' +
  38.                  ' end of database ' +
  39.             '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<';
  40.  
  41.   High_Message : STRING [7] = '';
  42.  
  43.   cursorState : BYTE = 1;  {0..3}
  44.   cursorData : ARRAY [0..3] OF CHAR = (#179, #47, #196, #92);
  45.  
  46.   DATFileName = 'MESSAGES.DAT';
  47.   CNFFileName = 'CONTROL.DAT';
  48.   lf = #13#10;
  49.  
  50. VAR confnumb : WORD;
  51.   field    : STRING;
  52.   inverse  : BOOLEAN;
  53.  
  54. VAR
  55.   unQWK, unARC, unARJ, unHAP, unLHA,
  56.   unPAK, unRAR, unUC2, unZIP, unZOO : PATHSTR;
  57.   ExCMD : PATHSTR;
  58.  
  59.   CheckFROM,
  60.   Validate,
  61.   TrackPrivate : BOOLEAN;
  62.   CONFname : STRING [25];
  63.  
  64. {===========================================================================}
  65.  
  66. PROCEDURE WriteError (CONST problem: BYTE);
  67. FUNCTION WordToHex (i: WORD): STRING;
  68. PROCEDURE CheckIO;
  69. PROCEDURE cursorOff;
  70. PROCEDURE cursorOn;
  71. PROCEDURE updateCursor;
  72. FUNCTION WhereX: BYTE;
  73. FUNCTION WhereY: BYTE;
  74. PROCEDURE GotoXY (X, Y: BYTE);
  75. PROCEDURE WriteCharAtCursor (X: CHAR);
  76. PROCEDURE ClrEol;
  77. PROCEDURE WriteMemAvail;
  78. FUNCTION IsFile (CONST FileName: PATHSTR): BOOLEAN;
  79. PROCEDURE EraseFile (CONST FileName : STRING);
  80. (* PROCEDURE UpFast (VAR Str: STRING);  {** from SWAG **} *)
  81. FUNCTION UpStr (lstr : STRING): STRING;
  82. FUNCTION LowerStr (w: STRING): STRING;
  83. FUNCTION MixCase (s: STRING): STRING;
  84. FUNCTION RTrim (InStr: STRING): STRING;
  85. FUNCTION LTrim (InStr: STRING): STRING;
  86. FUNCTION Squeeze (ss: STRING): STRING;
  87. Function LongIntDays (DayStr: String): LongInt;
  88. FUNCTION GetNewHigh (High, current: STRING): STRING;
  89. FUNCTION MiddleOf (CONST s: STRING): STRING;
  90. FUNCTION GetOriginLine (ol : STRING): STRING;
  91. FUNCTION GetConfNUMBER (CONST PSTR: STRING): PATHSTR;
  92. FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
  93. FUNCTION GetFilePath (CONST PSTR: STRING; VAR sDir: DIRSTR): PATHSTR;
  94. FUNCTION GetCONFname (CONST QWKpath, CNFFileName: STRING): STRING;
  95. FUNCTION BuildList (VAR list: MemLink; CONST fname: STRING): WORD;
  96. FUNCTION ReadDAT (VAR list: MemLink; CONST DATFileName: STRING): WORD;
  97. FUNCTION Relevant (CONST s: STRING; CONST len: BYTE): STRING;
  98. PROCEDURE GetSortField (CONST PSTR: STRING);
  99. FUNCTION CompareFields (CONST cnode, cnode2: MemLink): BOOLEAN;
  100. PROCEDURE SortLinkedList (VAR list: MemLink);  {By Ian Lin, found in SWAG}
  101. PROCEDURE WriteList (VAR list: MemLink; CONST fname: STRING; CONST mems: WORD);
  102. PROCEDURE WriteStats (VAR list: MemLink; CONST fname: STRING; CONST mems: WORD);
  103. PROCEDURE InitCONFIG;
  104. FUNCTION IsArchive (CONST SomeFile: PATHSTR): PATHSTR;
  105. FUNCTION ExtractFile (CONST ArchiveFile, FileToEx: PATHSTR; ExCMD: PATHSTR): BOOLEAN;
  106.  
  107. {===========================================================================}
  108.  
  109. IMPLEMENTATION
  110.  
  111. PROCEDURE WriteError (CONST problem: BYTE);
  112. VAR
  113.   message: STRING [79];
  114. BEGIN
  115.   CASE problem OF
  116.     1 : message := 'Invalid parameter on command line or parameter missing.';
  117.     2 : message := 'No files found.  First parameter must be a valid file specification.';
  118.     3 : message := 'You cannot use ".STT" as the file extension, since .STT is used by CPT-Stat.';
  119.  
  120. (*  Numbers 4 and 5 are -possible- reasons for aborting, but I've chosen not to.  *)
  121.  
  122. (*  4 : message := 'Configuration file not found with executable.  Consult the documentation.'; *)
  123. (*  5 : message := 'Unable to run unarchiver!  Aborting.';                                      *)
  124.  
  125.     6 : message := 'You cannot just specify a path, add "*.*" or "\*.*" for all files.';
  126.     7 : message := 'File handling error.  Original has not been updated, and is possibly corrupt.';
  127.     8 : message := 'This database was corrupted by CPT v1.36, read the "CPT-Fix.DOC" file for help.';
  128.     ELSE  message := 'Unknown error.';
  129.   END;
  130.   WriteLn (#7, 'Error encountered, number ', problem, ':'); WriteLn (message);
  131. END;
  132.  
  133. FUNCTION WordToHex (i: WORD): STRING; {Convert a WORD variable to STRING}
  134. CONST
  135.   HexLetters : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  136. BEGIN
  137.   WordToHex := Concat (HexLetters [Hi (i) SHR 4], HexLetters [Hi (i) AND 15],
  138.                        HexLetters [Lo (i) SHR 4], HexLetters [Lo (i) AND 15]);
  139. END;
  140.  
  141. PROCEDURE CheckIO;
  142. BEGIN
  143.   IF IOResult <> 0 THEN Halt (7);
  144. END;
  145.  
  146. PROCEDURE cursorOff; ASSEMBLER;
  147. (* Routine from SWAG *)
  148. ASM
  149.   mov AH, 3; mov BH, 0; Int $10; OR CH, $20; mov AH, 1; Int $10;
  150. END;
  151.  
  152. PROCEDURE cursorOn; ASSEMBLER;
  153. (* Routine from SWAG *)
  154. ASM
  155.   mov AH, 3; mov BH, 0; Int $10; AND CH, NOT $20; mov AH, 1; Int $10;
  156. END;
  157.  
  158. PROCEDURE updateCursor;
  159. BEGIN
  160.   cursorState := Succ (cursorState) AND 3;
  161.   Write (cursorData [cursorState], ^H);
  162. END;
  163.  
  164. FUNCTION WhereX: BYTE; ASSEMBLER;
  165. (* Routine from SWAG *)
  166. ASM
  167.   MOV AH, 3     {Ask For current cursor position}
  168.   MOV BH, 0     { On page 0 }
  169.   Int 10h       { Return inFormation in DX }
  170.   Inc DL        { Bios Assumes Zero-based. Crt.WhereX Uses 1 based }
  171.   MOV AL, DL    { Return X position in AL For use in Byte Result }
  172. END;
  173.  
  174. FUNCTION WhereY: BYTE; ASSEMBLER;
  175. (* Routine from SWAG *)
  176. ASM
  177.   MOV AH, 3    {Ask For current cursor position}
  178.   MOV BH, 0    { On page 0 }
  179.   Int 10h      { Return inFormation in DX }
  180.   Inc DH       { Bios Assumes Zero-based. Crt.WhereY Uses 1 based }
  181.   MOV AL, DH   { Return Y position in AL For use in Byte Result }
  182. END;
  183.  
  184. PROCEDURE GotoXY (X, Y: BYTE); ASSEMBLER;
  185. (* Routine from SWAG *)
  186. ASM
  187.   MOV DH, Y    { DH = Row (Y) }
  188.   MOV DL, X    { DL = Column (X) }
  189.   Dec DH       { Adjust For Zero-based Bios routines }
  190.   Dec DL       { Turbo Crt.GotoXY is 1-based }
  191.   MOV BH, 0    { Display page 0 }
  192.   MOV AH, 2    { Call For SET CURSOR POSITION }
  193.   Int 10h
  194. END;
  195.  
  196. PROCEDURE WriteCharAtCursor (X: CHAR);
  197. (* Routine from SWAG *)
  198. VAR
  199.   reg: REGISTERS;
  200. BEGIN
  201.   reg. AH := $0A;
  202.   reg. AL := Ord (X);
  203.   reg. BH := $00;    {* Display Page Number. * for Graphics Modes! *}
  204.   reg. CX := 1;      {* Word for number of characters to write *}
  205.   Intr ($10, reg);
  206. END;
  207.  
  208. PROCEDURE ClrEol;
  209. (* Routine by DDA *)
  210. VAR
  211.   NumCol: WORD ABSOLUTE $0040: $004A; { Number of CRT columns (1-based) }
  212.   X, Y, DistanceToRight: BYTE;
  213. BEGIN
  214.   X := WhereX;
  215.   Y := WhereY;
  216.   DistanceToRight := NumCol - X;
  217.   Write ('': DistanceToRight);
  218.   WriteCharAtCursor (#32);
  219.   GotoXY (X, Y);
  220. END;
  221.  
  222. PROCEDURE WriteMemAvail;
  223. BEGIN
  224.   GotoXY (60, WhereY);
  225.   WriteLn ('Free RAM: ', MemAvail);
  226. END;
  227.  
  228. FUNCTION IsFile (CONST FileName: PATHSTR): BOOLEAN;
  229. VAR
  230.   Attr  : WORD;
  231.   cFile : FILE;
  232. BEGIN
  233.   Assign (cFile, FileName);
  234.   GetFAttr (cFile, Attr);
  235.   IF (DosError = 0) AND ((Attr AND Directory) <> Directory)
  236.     THEN IsFile := TRUE
  237.     ELSE IsFile := FALSE;
  238. END;
  239.  
  240. PROCEDURE EraseFile (CONST FileName : STRING);
  241. VAR
  242.   cFile : FILE;
  243. BEGIN
  244.   IF IsFile (FileName) THEN BEGIN
  245.     Assign (cFile, FileName);
  246.     SetFAttr (cFile, 0);
  247.     Erase (cFile); CheckIO;
  248.   END;
  249. END;
  250.  
  251. PROCEDURE UpFast (VAR Str: STRING);  {** from SWAG **}
  252. INLINE ($8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('a')/Ord('z')/
  253.         $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$6C/$FF/$20/$E2/$F1/$8E/$DA);
  254.  
  255. FUNCTION UpStr (lstr : STRING): STRING;
  256. BEGIN
  257.   upfast (lstr);
  258.   UpStr := lstr;
  259. END;
  260.  
  261. FUNCTION LowerStr (w: STRING): STRING;
  262. VAR
  263.   cp  : INTEGER;        {The position of the character to change.}
  264. BEGIN
  265.   FOR cp := 1 TO Length (w) DO
  266.     IF w [cp] in ['A'..'Z'] THEN
  267.       System.Inc (w [cp], 32);
  268.   LowerStr := w;
  269. END;
  270.  
  271. FUNCTION MixCase (s: STRING): STRING;
  272. CONST
  273.   space  = #32;
  274.   hyphen = #45;
  275.   period = #46;
  276. VAR
  277.   cp  : INTEGER;        {The position of the character to change.}
  278.   s2  : STRING;
  279. BEGIN
  280.   s := LowerStr(s);
  281.  
  282.   s [1] := UpCase (s [1]);  { Capitalize first letter }
  283.  
  284.   s2 := '';
  285.   WHILE Pos (space, s) > 0 DO BEGIN  { Capitalize initial letters after spaces }
  286.     s2 := s2 + Copy (s, 1, (Pos (space, s)));
  287.     Delete (s, 1, (Pos (space, s)));
  288.     s [1] := UpCase (s [1]);
  289.   END;
  290.   IF (Length (s) >= 3) AND (Copy (s, 1, 2) = 'Mc') THEN
  291.     s [3] := UpCase (s [3]);  { Capitalize third letter of "McKay", etc. }
  292.   IF (Length (s) = 2) AND (Copy (s, 1, 2) = 'Ii') THEN
  293.     s [2] := UpCase (s [2]);  { Capitalize "II" }
  294.   s2 := s2 + s;
  295.   s := s2;
  296.  
  297.   s2 := '';
  298.   WHILE Pos (hyphen, s) > 0 DO BEGIN  { Capitalize initial letters after hypens}
  299.     s2 := s2 + Copy (s, 1, (Pos (hyphen, s)));
  300.     Delete (s, 1, (Pos (hyphen, s)));
  301.     s [1] := UpCase (s [1]);
  302.   END;
  303.   s2 := s2 + s;
  304.   s := s2;
  305.  
  306.   s2 := '';
  307.   WHILE Pos (period, s) > 0 DO BEGIN  { Capitalize initial letters after periods}
  308.     s2 := s2 + Copy (s, 1, (Pos (period, s)));
  309.     Delete (s, 1, (Pos (period, s)));
  310.     s [1] := UpCase (s [1]);
  311.   END;
  312.   s2 := s2 + s;
  313.   s := s2;
  314.  
  315.   MixCase := s;
  316. END;
  317.  
  318. FUNCTION RTrim (InStr: STRING): STRING;
  319. BEGIN
  320.   WHILE (Length (InStr) > 0) AND (InStr [Length (InStr)] IN [#0, #9, #32]) DO
  321.     system. Dec (InStr [0]);
  322.   RTrim := InStr;
  323. END;
  324.  
  325. FUNCTION LTrim (InStr: STRING): STRING;
  326. BEGIN
  327.   WHILE (Length (InStr) > 0) AND (InStr [1] IN [#0, #9, #32]) DO
  328.     Delete (InStr, 1, 1);
  329.   LTrim := InStr;
  330. END;
  331.  
  332. FUNCTION Squeeze (ss: STRING): STRING;
  333. VAR
  334.   controlCHAR: CHAR;
  335. BEGIN
  336.   FOR controlCHAR := #0 TO #31 DO
  337.     WHILE (Ord (ss [0]) > 0) AND (Pos (controlCHAR, ss) > 0) DO
  338.       ss [Pos (controlCHAR, ss)] := #32;
  339.   ss := RTrim (LTrim (ss));
  340.   Squeeze := ss
  341. END;
  342.  
  343. Function LongIntDays (DayStr: String): LongInt;
  344. Var
  345.  LID : LongInt;
  346.  VErr : Integer;
  347. Begin
  348.  DayStr := Copy(DayStr,7,2) + Copy(DayStr,1,2) + Copy(DayStr,4,2);
  349.  If DayStr[1] in ['8','9']
  350.    Then DayStr := '19'+DayStr  {assume 1980-1999, rather than 2080-2099}
  351.    Else DayStr := '20'+DayStr;
  352.  Val(DayStr,LID,VErr);
  353.  If VErr <> 0
  354.    Then LongIntDays := 0
  355.    Else LongIntDays := LID
  356. End;
  357.  
  358. FUNCTION GetNewHigh (High, current: STRING): STRING;
  359. VAR
  360.   old, New: LONGINT;
  361.   verr: INTEGER;
  362. BEGIN
  363.   Val (Squeeze (High), old, verr);
  364.   Val (Squeeze (current), New, verr);
  365.   IF (New > old)
  366.     THEN GetNewHigh := Squeeze (current)
  367.     ELSE GetNewHigh := High
  368. END;
  369.  
  370. FUNCTION MiddleOf (CONST s: STRING): STRING;
  371. VAR
  372.   pre_mid, post_mid : BYTE;
  373. BEGIN
  374.   pre_mid := 5 * Length (s) DIV 10;
  375.   post_mid := 7 * Length (s) DIV 10;
  376.   MiddleOf := Copy (s, pre_mid, (post_mid - pre_mid))
  377. END;
  378.  
  379. FUNCTION GetOriginLine (ol : STRING): STRING;
  380. VAR
  381.   Pos1: BYTE;
  382.   DONE: BOOLEAN;
  383. BEGIN
  384.   DONE := FALSE;
  385.  
  386.   IF NOT DONE THEN  { First search for standard QWK origin line }
  387.   REPEAT
  388.     Pos1 := Pos ('π ■', ol);
  389.     IF (Pos1 > 0) THEN
  390.     BEGIN
  391.       DONE := TRUE;
  392.       ol := Copy (ol, Pos1+1, 255);  { Copy entire remaining line }
  393.     END;
  394.   UNTIL (Pos1 = 0);
  395.  
  396.   IF NOT DONE THEN  { Second search for standard FIDO origin line }
  397.   REPEAT
  398.     Pos1 := Pos ('π *', ol);
  399.     IF (Pos1 > 0) THEN
  400.     BEGIN
  401.       DONE := TRUE;
  402.       ol := Copy (ol, Pos1+1, 255);  { Copy entire remaining line }
  403.     END;
  404.   UNTIL (Pos1 = 0);
  405.  
  406.   IF NOT DONE THEN  { Third search for non-standard QWK origin line }
  407.   REPEAT
  408.     Pos1 := Pos ('π■', ol);
  409.     IF (Pos1 > 0) THEN
  410.     BEGIN
  411.       DONE := TRUE;
  412.       ol := Copy (ol, Pos1+1, 255);  { Copy entire remaining line }
  413.     END;
  414.   UNTIL (Pos1 = 0);
  415.  
  416.   IF NOT DONE THEN  { Fourth search for non-standard FIDO origin line }
  417.   REPEAT
  418.     Pos1 := Pos ('π*', ol);
  419.     IF (Pos1 > 0) THEN
  420.     BEGIN
  421.       DONE := TRUE;
  422.       ol := Copy (ol, Pos1+1, 255);  { Copy entire remaining line }
  423.     END;
  424.   UNTIL (Pos1 = 0);
  425.  
  426.   IF DONE THEN
  427.   BEGIN
  428.     Pos1 := Pos (#1, ol);
  429.     IF Pos1 > 0 THEN
  430.       ol := Copy (ol, 1, Pos1 - 1);
  431.  
  432.     Pos1 := Pos (#227, ol);          { | new with v1.52 }
  433.     IF Pos1 > 0 THEN
  434.       ol := Copy (ol, 1, Pos1 - 1);
  435.  
  436.     WHILE (Ord (ol [0]) > 0) AND (ol [Length (ol)] IN [#0, #9, #32]) DO
  437.       Delete (ol, Length (ol), 1);   { | changed with v1.52 }
  438.  
  439. (*  WHILE (Ord (ol [0]) > 0) AND (ol [Length (ol)] IN [#0, #32, #227]) DO
  440.       Delete (ol, Length (ol), 1);
  441.     WHILE Pos (#227, ol) > 0 DO
  442.       Delete (ol, 1, Pos (#227, ol));  *)
  443.  
  444.     ol := squeeze (ol);
  445.     IF (Length (ol) > 78) THEN
  446.       ol := Copy (ol, 1, 78);
  447.     GetOriginLine := #32 + ol;
  448.   END
  449.   ELSE
  450.     GetOriginLine := '';
  451. END;
  452. {===========================================================================}
  453.  
  454. FUNCTION GetConfNUMBER (CONST PSTR: STRING): PATHSTR;
  455. VAR
  456.   MFNpath   : PATHSTR;    { MFN file path,          }
  457.   MFNdir    : DIRSTR;     {             directory,  }
  458.   MFNname   : NAMESTR;    {             name,       }
  459.   MFNext    : EXTSTR;     {             extension.  }
  460.  
  461.   sTemp : STRING;
  462.   index : BYTE;
  463.   VErr  : INTEGER;
  464. BEGIN
  465.   MFNpath := PSTR;
  466.   IF MFNpath [1] IN ['/', '-'] THEN Halt (1);
  467.   FSplit (FExpand (MFNpath), MFNdir, MFNname, MFNext);
  468.   IF (MFNname = '')  THEN Halt (6);
  469.   IF (MFNext = '.STT')  THEN Halt (3);
  470.   
  471.   sTemp := '';
  472.   FOR index := 1 TO Length (MFNname) DO
  473.     IF MFNname [index] IN ['0'..'9'] THEN
  474.       sTemp := sTemp + MFNname [index];
  475.   IF sTemp = '' THEN Halt (1);
  476.   Val (sTemp, confnumb, VErr);  { confnumb is a GLOBAL var }
  477.   IF VErr <> 0 THEN Halt (1);
  478.  
  479.   GetConfNUMBER := MFNdir + MFNname+ MFNext;
  480. END;
  481. {===========================================================================}
  482.  
  483. FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
  484. VAR
  485.   Attr  : WORD;
  486.   cFile : FILE;
  487. BEGIN
  488.   Assign (cFile, FileName);
  489.   GetFAttr (cFile, Attr);
  490.   IF (DosError = 0) AND ((Attr AND Directory) = Directory)
  491.     THEN IsDir := TRUE
  492.     ELSE IsDir := FALSE;
  493. END;
  494.  
  495. FUNCTION GetFilePath (CONST PSTR: STRING; VAR sDir: DIRSTR): PATHSTR;
  496. VAR
  497.   jPath     : PATHSTR;  { file path,       }
  498.   jDir      : DIRSTR;   {      directory,  }
  499.   jName     : NAMESTR;  {      name,       }
  500.   jExt      : EXTSTR;   {      extension.  }
  501. BEGIN
  502.   jPath := PSTR;
  503.   IF jPath = '' THEN jPath := '*.*';
  504.   IF (NOT (jPath [Length (jPath)] IN [':', '\'])) AND IsDir (jPath) THEN
  505.     jPath := jPath + '\';
  506.   IF (jPath [Length (jPath)] IN [':', '\']) THEN
  507.     jPath := jPath + '*.*';
  508.  
  509.   FSplit (FExpand (jPath), jDir, jName, jExt);
  510.   jPath := jDir + jName+ jExt;
  511.  
  512.   sDir := jDir;
  513.   GetFilePath := jPath;
  514. END;
  515.  
  516. {===========================================================================}
  517.  
  518. FUNCTION GetCONFname (CONST QWKpath, CNFFileName: STRING): STRING;
  519. VAR X, Y: WORD;
  520.   CNFFile  : TEXT;
  521.   CnfName,
  522.   CNameStr : STRING;
  523.   CNumb,
  524.   CNameInt : WORD;
  525.   VErr     : INTEGER;
  526. BEGIN
  527.   CnfName := '';
  528.   IF ExtractFile (QWKpath, CNFFileName, ExCMD) THEN BEGIN
  529.     Assign (CNFFile, CNFFileName);
  530.     Reset (CNFFile); CheckIO;
  531.     
  532.     FOR X := 1 TO 10 DO      { advance to just before number of Cnferences }
  533.       IF NOT EoF (CNFFile) THEN
  534.         ReadLn (CNFFile);
  535.     
  536.     IF NOT EoF (CNFFile) THEN BEGIN
  537.       ReadLn (CNFFile, CNameStr);           { get number of Cnferences }
  538.       Val (Squeeze (CNameStr), CNameInt, VErr);
  539.       IF (VErr = 0) THEN
  540.         FOR X := 0 TO CNameInt DO           { walk through Cnf names }
  541.           IF NOT EoF (CNFFile) THEN BEGIN
  542.             ReadLn (CNFFile, CNameStr);       { read Cnference number }
  543.             Val (Squeeze (CNameStr), CNumb, VErr);
  544.             IF (VErr = 0) AND (NOT EoF (CNFFile)) THEN BEGIN
  545.               ReadLn (CNFFile, CNameStr);     { read Cnference name }
  546.               IF CNumb = ConfNumb THEN
  547.                 CnfName := CNameStr
  548.             END;
  549.           END;
  550.     END;
  551.     Close (CNFFile);
  552.     EraseFile (CNFFileName);
  553.   END;
  554.   GetConfname := CnfName;
  555. END;
  556. {===========================================================================}
  557.  
  558. FUNCTION BuildList (VAR list: MemLink; CONST fname: STRING): WORD;
  559. CONST
  560.   namepos = 3; sentpos = namepos + 31; oldestpos = sentpos + 14; newestpos = oldestpos + 13;
  561.   bbs1Pos = 1; bbs2Pos = 1; notespos = 7;
  562. VAR
  563.   MemInfo    : STRING;
  564.   anchor,
  565.   MemberInfo : MemLink;
  566.   infile     : TEXT;
  567.   VErr       : INTEGER;
  568.   Members    : WORD;
  569.   DataEnd    : BOOLEAN;
  570. BEGIN
  571.   Write ('Reading membership list, please wait ... ');
  572.   DataEnd := FALSE;
  573.   Members := 0;
  574.   IF IsFile (fname) THEN BEGIN
  575.     Assign (infile, fname);
  576.     Reset (infile); CheckIO;
  577.     list := NIL;
  578.     anchor := NIL;
  579.     MemberInfo := NIL;
  580.     ReadLn (infile, MemInfo); CheckIO;
  581.     IF Copy(MemInfo,1,9) = 'CPT v1.36'
  582.       THEN Halt(8)
  583.       ELSE Reset (infile); CheckIO;
  584.     WHILE NOT DataEnd DO
  585.     BEGIN
  586.       REPEAT      { find first separator line }
  587.         ReadLn (infile, MemInfo); CheckIO;
  588.         IF (Length (MemInfo) >= 15) AND (Copy (MemInfo, 1, 14) = 'High message: ') THEN
  589.           High_Message := Copy (MemInfo, 15, Length (MemInfo) - 14)
  590.         ELSE
  591.           IF (Length (MemInfo) > 50) AND (Copy (MemInfo, 1, 11) = 'Conference ') THEN
  592.             IF (Pos ('(', MemInfo) < Pos (')', MemInfo)) THEN
  593.               CONFname := Copy (MemInfo, Pos ('(', MemInfo) + 1,
  594.               Pos (')', MemInfo) - Pos ('(', MemInfo) - 1);
  595.         IF EoF (infile) OR (MemInfo = EndOfDB) THEN DataEnd := TRUE;
  596.       UNTIL (MemInfo = DelimitLine) OR DataEnd OR (MemInfo = OldDelimitLine);
  597.       IF NOT DataEnd THEN BEGIN  { assume start of new data }
  598.  
  599.         updatecursor;
  600.         Inc (Members);
  601.         New (MemberInfo);
  602.         WITH MemberInfo^ DO BEGIN
  603.           Name := '';
  604.           sent := 0;
  605.           oldest := '';
  606.           newest := '';
  607.           BBS1 := '';
  608.           BBS2 := '';
  609.           notes := '';
  610.           next := NIL;
  611.         END; {with}
  612.  
  613.         REPEAT  { fill in new data }
  614.           ReadLn (infile, MemInfo); CheckIO;
  615.           IF EoF (infile) OR (MemInfo = EndOfDB) THEN DataEnd := TRUE;
  616.           IF (NOT DataEnd) THEN
  617.             WITH MemberInfo^ DO BEGIN
  618.               IF Copy (MemInfo, 1, 2) = ': ' THEN BEGIN
  619.                 Name := MixCase (Squeeze (Copy (MemInfo, namepos, SizeOf (Name))));
  620.                 Val (Squeeze (Copy (MemInfo, sentpos, 4)), sent, VErr);
  621.                 oldest := Copy (MemInfo, oldestpos, SizeOf (oldest));
  622.                 newest := Copy (MemInfo, newestpos, SizeOf (newest));
  623.               END
  624.               ELSE IF Copy (MemInfo, 1, 6) = 'Notes:' THEN BEGIN
  625.                 notes := MemInfo;
  626.                 Delete (notes, 1, notespos - 1);
  627.               END
  628.                 ELSE IF BBS1 = '' THEN BEGIN
  629.                   BBS1 := MemInfo;
  630.                   Delete (BBS1, 1, BBS1Pos - 1);
  631.                 END
  632.                   ELSE IF BBS2 = '' THEN BEGIN
  633.                     BBS2 := MemInfo;
  634.                     Delete (BBS2, 1, BBS2Pos - 1);
  635.                   END
  636.             END; {with}
  637.         UNTIL DataEnd OR (Copy (MemInfo, 1, 6) = 'Notes:');
  638.  
  639.         IF list <> NIL THEN
  640.           list^. next := MemberInfo
  641.         ELSE
  642.           anchor := MemberInfo;
  643.  
  644.         list := MemberInfo;
  645.       END {if}
  646.     END; {while}
  647.     Close (infile); CheckIO;
  648.     ClrEol;
  649.     list := anchor;
  650.   END;
  651.   Write ('done!');
  652.   BuildList := Members;
  653. END;
  654. {===========================================================================}
  655.  
  656. FUNCTION ReadDAT (VAR list: MemLink; CONST DATFileName: STRING): WORD;
  657. CONST RecSize  = 128;
  658. TYPE  Buffer   = ARRAY [1..RecSize] OF CHAR;
  659. VAR
  660.   MemInfo : Buffer;
  661.   anchor, newMEM  : MemLink;
  662.   
  663.   NewName : STRING [25];
  664.   NextMes : WORD;
  665.   VErr    : INTEGER;
  666.   
  667.   CrnDate : STRING [8];
  668.   confnum : WORD;
  669.   PRIVATE : BOOLEAN;
  670.   BBStemp : STRING;
  671.   
  672.   dfile   : FILE;
  673.   count,
  674.   Members : WORD;
  675.   NamePos : BYTE;
  676. BEGIN
  677.   IF CheckFROM THEN NamePos := 47
  678.   ELSE NamePos := 22;
  679.   Members := 0;
  680.   NextMes := 2;
  681.   Assign (dfile, DATFileName);
  682.   Reset (dfile, 1); CheckIO;
  683.   REPEAT
  684.     updatecursor;
  685.     FOR count := 1 TO NextMes DO BEGIN
  686.       BlockRead (dfile, MemInfo, RecSize);
  687.       IF (IOResult <> 0) THEN Continue;
  688.     END;
  689.     BBStemp := '';
  690.     Val (Squeeze (Copy (MemInfo, 117, 6)), NextMes, VErr);
  691.     IF NextMes < 1 THEN NextMes := 1;
  692.  
  693.     confnum := Ord (MemInfo [125]) * 256 + Ord (MemInfo [124]);
  694.     IF TrackPrivate = TRUE THEN
  695.       PRIVATE := FALSE   {Pretend *all* messages are Public}
  696.     ELSE
  697.       PRIVATE := Pos (MemInfo [1], '+*~`!#') > 0;
  698.  
  699.     IF (confnum = ConfNumb) AND (NOT PRIVATE) THEN BEGIN
  700.       High_Message := GetNewHigh (High_Message, Copy (MemInfo, 2, 7));
  701.       NewName := MixCase (Squeeze (Copy (MemInfo, NamePos, 25)));
  702.       IF (Validate = FALSE) OR
  703.          ((NewName <> '') AND (Pos (#0, NewName) < 1)
  704.          AND (NewName [1] IN ['A'..'Z']))
  705.       THEN BEGIN
  706.         anchor := list;
  707.         WHILE (list <> NIL) AND (list^. Name <> NewName) DO list := list^. next;
  708.         IF list = NIL THEN BEGIN
  709.           list := anchor;
  710.           Inc (Members);
  711.           New (newMEM);
  712.           WITH newMEM^ DO BEGIN
  713.             Name := NewName;
  714.             sent := 1;
  715.             oldest := Copy (MemInfo, 9, 8);
  716.             newest := oldest;
  717.  
  718.             WHILE NextMes > 1 DO BEGIN
  719.               IF Length (BBStemp) > 127 THEN
  720.                 Delete (BBStemp, 1, (Length (BBStemp) - 127));
  721.               BlockRead (dfile, MemInfo, RecSize); CheckIO;
  722.               IF CheckFROM THEN BBStemp := BBStemp + MemInfo;
  723.               system. Dec (NextMes);
  724.             END;
  725.  
  726.             IF CheckFROM THEN BEGIN
  727.               BBStemp := GetOriginLine (BBStemp);
  728.               IF (Length (BBStemp) > 2) AND (BBStemp [2] IN [#42, #254]) THEN
  729.                 BBS1 := BBStemp
  730.               ELSE
  731.                 BBS1 := ' * Unknown origin';
  732.             END
  733.             ELSE
  734.               BBS1 := '';
  735.  
  736.             BBS2 := '';
  737.             notes := ' !New!';
  738.             next := list;
  739.           END;
  740.           list := newMEM;
  741.         END {if list = nil then}
  742.         ELSE BEGIN {name was found}
  743.           WITH list^ DO BEGIN
  744.             sent := (sent) + 1;
  745.             CrnDate := Copy (MemInfo, 9, 8);
  746.             IF LongIntDays (CrnDate) < LongIntDays (oldest) THEN oldest := CrnDate;
  747.             IF LongIntDays (CrnDate) > LongIntDays (newest) THEN newest := CrnDate;
  748.  
  749.             WHILE NextMes > 1 DO BEGIN
  750.               IF Length (BBStemp) > 127 THEN
  751.                 Delete (BBStemp, 1, (Length (BBStemp) - 127));
  752.               BlockRead (dfile, MemInfo, RecSize); CheckIO;
  753.               IF CheckFROM THEN BBStemp := BBStemp + MemInfo;
  754.               system. Dec (NextMes);
  755.             END;
  756.  
  757.             IF CheckFROM THEN BEGIN
  758.               BBStemp := GetOriginLine (BBStemp);
  759.               IF (Length (BBStemp) > 2) AND (BBStemp [2] IN [#42, #254]) THEN
  760.                 IF (MiddleOf (BBStemp) <> MiddleOf (BBS1)) THEN
  761.                 BEGIN  { make BBStemp the most recent }
  762.                   BBS2 := BBS1;
  763.                   BBS1 := BBStemp
  764.                 END
  765.               ELSE BBS1 := BBStemp;
  766.             END;
  767.  
  768.           END;
  769.           list := anchor
  770.         END  {if list = nil then ... else}
  771.       END  {if (NewName <> '') AND (Pos(#0,NewName) < 1) ... }
  772.     END  {if (confnum = ConfNumb) and (NOT private) then}
  773.   UNTIL EoF (dfile);
  774.   ClrEol;
  775.   Close (dfile); CheckIO;
  776.   ReadDat := Members;
  777. END;
  778. {===========================================================================}
  779.  
  780. FUNCTION Relevant (CONST s: STRING; CONST len: BYTE): STRING;
  781. BEGIN
  782.   Relevant := Copy (s, 1, len);
  783. END;
  784.  
  785. PROCEDURE GetSortField (CONST PSTR: STRING);
  786. BEGIN
  787.   field := Squeeze (UpStr (PSTR));
  788.   Write ('Sorting membership list by: '+field+', please wait ... ');
  789.   IF field = '' THEN field := 'NAME';
  790.   inverse := (field [1] = '-');
  791.   IF inverse THEN Delete (field, 1, 1);
  792.   field := Relevant (field, 3);
  793. END;
  794.  
  795. FUNCTION CompareFields (CONST cnode, cnode2: MemLink): BOOLEAN;
  796. BEGIN
  797.   { Originally was: (node^.name > node2^.next^.name) }
  798.  
  799.   IF field = 'NAM' THEN BEGIN
  800.     IF inverse THEN
  801.       CompareFields := (cnode^. Name <= cnode2^. next^. Name)
  802.     ELSE
  803.       CompareFields := (cnode^. Name >= cnode2^. next^. Name)
  804.   END
  805.   ELSE
  806.     IF field = 'SEN' THEN BEGIN
  807.       IF inverse THEN
  808.         CompareFields := (cnode^. SENT <= cnode2^. next^. SENT)
  809.       ELSE
  810.         CompareFields := (cnode^. SENT >= cnode2^. next^. SENT)
  811.     END
  812.   ELSE
  813.     IF field = 'OLD' THEN BEGIN
  814.       IF inverse THEN
  815.         CompareFields := (LongIntDays (cnode^. OLDEST) <= LongIntDays (cnode2^. next^. OLDEST))
  816.       ELSE
  817.         CompareFields := (LongIntDays (cnode^. OLDEST) >= LongIntDays (cnode2^. next^. OLDEST))
  818.     END
  819.   ELSE
  820.     IF field = 'NEW' THEN BEGIN
  821.       IF inverse THEN
  822.         CompareFields := (LongIntDays (cnode^. NEWEST) <= LongIntDays (cnode2^. next^. NEWEST))
  823.       ELSE
  824.         CompareFields := (LongIntDays (cnode^. NEWEST) >= LongIntDays (cnode2^. next^. NEWEST))
  825.     END
  826. END;
  827. {===========================================================================}
  828.  
  829. PROCEDURE SortLinkedList (VAR list: MemLink);  {By Ian Lin, found in SWAG}
  830. VAR
  831.   list2,                       {first and second lists, temporary }
  832.   node,                        {  Pointers to nodes in the lists  }
  833.   node2  : MemLink;
  834. BEGIN
  835.   New (list2);            {begin NEW sorted list}
  836.   list2^. next := list;   {steal the first node of list For list2}
  837.   list := list^. next;
  838.   list2^. next^. next := NIL;
  839.   WHILE list <> NIL DO
  840.   BEGIN                  {now steal 'em all and add them in order}
  841.     node := list;        {point node to first node in LIST}
  842.     list := list^. next; {advance LIST Pointer one node, first node is now seperate}
  843.     node2 := list2;      {ready to use NODE2 to find the correct entry point}
  844.  
  845.     WHILE (node2^. next <> NIL) AND CompareFields (node, node2) DO
  846.       { (node^.name > node2^.next^.name) }
  847.       node2 := node2^. next;    {advance NODE2 as needed until it marks the
  848.                                  right place For NODE to be inserted}
  849.  
  850.     node^. next := node2^. next;  {insert NODE into the new list, in the correct order}
  851.  
  852.     node2^. next := node; {connect node to the previous nodes in the new list, if any}
  853.     updateCursor;
  854.   END;
  855.   list := list2^. next;   {point LIST back to the top of the list, now in order}
  856.  
  857.   list2^. next := NIL;
  858.   Dispose (list2);
  859.   ClrEol;
  860.   Write ('done!');
  861. END;
  862. {===========================================================================}
  863.  
  864. PROCEDURE WriteList (VAR list: MemLink; CONST fname: STRING; CONST mems: WORD);
  865. VAR
  866.   MemList : TEXT;
  867.   chain : MemLink;
  868.   sentORreceived : STRING [5];
  869.   Days : STRING[10];
  870. BEGIN
  871.   IF CheckFROM THEN sentORreceived := 'sent '
  872.                ELSE sentORreceived := 'rcvd ';
  873.   Assign (MemList, fname);
  874.   Rewrite (MemList); CheckIO;
  875.   Write ('Writing membership list, please wait ... ');
  876.  
  877.   WriteLn (MemList, 'CPT'+ version+ '(Conference Participation Tracker) text database.');
  878.   WriteLn (MemList);
  879.   WriteLn (MemList, 'Conference participation data for conference: ',confnumb,' ('+ CONFname+ ')');
  880.   WriteLn (MemList, 'Total participants: ',mems);
  881.   WriteLn (MemList, 'High message: '+ High_Message);
  882.   WriteLn (MemList);
  883.   WriteLn (MemList, '  This permanent data file may be edited, relatively freely.  Beware that:');
  884.   WriteLn (MemList);
  885.   WriteLn (MemList, '      1) The colon+space combination (: ) before each name must remain.');
  886.   WriteLn (MemList, '      2) The position of the names and dates must not be changed.');
  887.   WriteLn (MemList, '      3) The position of the number of messages sent must not be changed.');
  888.   WriteLn (MemList, '      4) The label "Notes:" before the notes must not be altered,');
  889.   WriteLn (MemList, '           BUT about 70 characters of notes may be added after the label.');
  890.   WriteLn (MemList, '      5) The delimiting lines between each participant must not be altered.');
  891.   WriteLn (MemList, '      6) The "High message: #####" line above should be left as is.');
  892.   WriteLn (MemList, '      7) Invalid records (5 lines per record) can and should be deleted.');
  893.   WriteLn (MemList);
  894.  
  895.   WHILE list <> NIL DO BEGIN
  896.     updatecursor;
  897.     WITH list^ DO BEGIN
  898.       WriteLn (MemList, DelimitLine);
  899.       Write   (MemList, ': ', Name, '': (26 - Length (Name)),
  900.                 sentORreceived, sent: 4, ', between '+oldest+' and '+newest);
  901.       Str ((1 + (Num_Days (newest) - Num_Days (oldest))), Days);
  902.       if Days = '1'
  903.         then Days := Days + ' day)'
  904.         else Days := Days + ' days)';
  905.       WriteLn (MemList, ' (', Days);
  906.       WriteLn (MemList, bbs1);
  907.       WriteLn (MemList, bbs2);
  908.       WriteLn (MemList, 'Notes:'+ notes);
  909.     END;
  910.     chain := list;
  911.     list := list^. next;
  912.     Dispose (chain);
  913.   END;
  914.   WriteLn (MemList, EndOfDB);
  915.   ClrEol;
  916.   Close (MemList); CheckIO;
  917.   Write ('done!');
  918. END;
  919. {===========================================================================}
  920.  
  921. PROCEDURE WriteStats (VAR list: MemLink; CONST fname: STRING; CONST mems: WORD);
  922. CONST
  923.   Header = 'Name                      ' +
  924.            'Sent    Oldest     Newest  Days  Avg.';
  925. VAR
  926.   MemList : TEXT;
  927.   chain : MemLink;
  928.   TotalSent : LONGINT;
  929.   count,
  930.   rank,
  931.   LastSent : WORD;
  932.   days : WORD;
  933. BEGIN
  934.   Assign (MemList, fname);
  935.   Rewrite (MemList); CheckIO;
  936.   Write ('Writing membership list, please wait ... ');
  937.  
  938.   TotalSent := 0;
  939.   chain := list;
  940.   WHILE (list <> NIL) DO BEGIN
  941.     Inc(TotalSent,list^.sent);
  942.     list := list^. next;
  943.   END;
  944.   list := chain;
  945.  
  946.     WriteLn (MemList);
  947.     WriteLn (MemList, ' Conference participation stats for conference: ', confnumb, ' ('+ CONFname+ ')');
  948.     WriteLn (MemList, '    Number of participants: ', mems);
  949.   IF TrackPrivate = TRUE THEN
  950.     WriteLn (MemList, '    Total messages counted:  ', TotalSent)
  951.   ELSE
  952.     WriteLn (MemList, '    Public messages posted: ', TotalSent);
  953.     WriteLn (MemList);
  954.  
  955.   IF (field = 'SEN') AND inverse THEN BEGIN
  956.     count := 0;
  957.     rank := 1;
  958.     LastSent := 65535;
  959.     WriteLn (MemList, 'Rank   '+Header);
  960.     Write (MemList, '~~~~~~~');
  961.   END
  962.   ELSE
  963.     WriteLn (MemList, Header);
  964.   WriteLn (MemList, Copy (DelimitLine, 1, 63));
  965.  
  966.   WHILE (list <> NIL) DO BEGIN
  967.     updatecursor;
  968.     WITH list^ DO BEGIN
  969.       IF (field = 'SEN') AND inverse THEN BEGIN
  970.         Inc (count);
  971.         IF sent <> LastSent THEN BEGIN
  972.           rank := count;
  973.           LastSent := sent
  974.         END;
  975.         Write (MemList, rank: 4, ':  ');
  976.       END;
  977.       Write (MemList, Name, '': (26 - Length (Name)), sent: 4, oldest: 11, newest: 11);
  978.       days := 1 + Num_Days (newest) - Num_Days (oldest);
  979.       Write (MemList, days: 5);
  980.       WriteLn (MemList, (sent / days): 6: 2);
  981.     END;
  982.     chain := list;
  983.     list := list^. next;
  984.     Dispose (chain);
  985.   END;
  986.   WriteLn (MemList);
  987.   WriteLn (MemList, '[end of CPT statistics]');
  988.   ClrEol;
  989.   Close (MemList); CheckIO;
  990.   Write ('done!');
  991. END;
  992. {===========================================================================}
  993.  
  994. PROCEDURE InitCONFIG;
  995. VAR
  996.   cpath : PATHSTR; {cpath, etc fully qualified pathnames of *.cfg files}
  997.   cdir  : DIRSTR;
  998.   cname : NAMESTR;
  999.   cext  : EXTSTR;
  1000.   CfgFile: TEXT;
  1001.   CfgLine,
  1002.   CfgVar, CfgVal: PATHSTR;
  1003.   equalPos: BYTE;
  1004.  
  1005. BEGIN
  1006.   FSplit (FExpand (ParamStr(0)), cdir, cname, cext); { break up path into components }
  1007.   cpath := cdir + cname + '.cfg';
  1008.  
  1009.   CONFname := '';
  1010.   Validate := TRUE;
  1011.   TrackPrivate := FALSE;
  1012.  
  1013.   unQWK := 'gus';
  1014.  
  1015.   unARC := 'pkxarc';
  1016.   unARJ := 'arj e -y';
  1017.   unHAP := 'pah e';
  1018.   unLHA := 'lha e';
  1019.   unPAK := 'pak e /wa';
  1020.   unRAR := 'rar e';
  1021.   unUC2 := 'uc e -f';
  1022.   unZIP := 'pkunzip -# -o';
  1023.   unZOO := 'zoo -extract';
  1024.  
  1025.   IF UpStr (cname) = 'CPT-T'
  1026.      THEN CheckFROM := FALSE
  1027.      ELSE CheckFROM := TRUE;
  1028.  
  1029.   IF IsFile (cpath) THEN
  1030.   BEGIN
  1031.     Assign (CfgFile, cpath);
  1032.     Reset (CfgFile); CheckIO;
  1033.     WHILE NOT SeekEoF (CfgFile) DO
  1034.     BEGIN { find vars }
  1035.       ReadLn (CfgFile, CfgLine);
  1036.       equalPos := Pos ('=', CfgLine);
  1037.       IF (equalPos > 1) AND (Length (CfgLine) > 8) THEN BEGIN
  1038.  
  1039.         CfgVar := Squeeze (UpStr (Copy (CfgLine, 1, equalPos - 1)));
  1040.         CfgVal := Squeeze (UpStr (Copy (CfgLine, equalPos + 1, Length (CfgLine) - equalPos)));
  1041.  
  1042.         IF (CfgVar = 'VALIDATE') THEN
  1043.         BEGIN
  1044.           IF CfgVal = 'FALSE' THEN Validate := FALSE;
  1045.         END
  1046.         ELSE IF (CfgVar = 'TRACKPRIVATE') THEN
  1047.         BEGIN
  1048.           IF CfgVal = 'TRUE' THEN TrackPrivate := TRUE;
  1049.         END
  1050.         ELSE IF (CfgVar = 'UNQWK') THEN
  1051.           unQWK := CfgVal
  1052.         ELSE IF (CfgVar = 'UNARC') THEN
  1053.           unARC := CfgVal
  1054.         ELSE IF (CfgVar = 'UNARJ') THEN
  1055.           unARJ := CfgVal
  1056.         ELSE IF (CfgVar = 'UNHAP') THEN
  1057.           unHAP := CfgVal
  1058.         ELSE IF (CfgVar = 'UNLHA') THEN
  1059.           unLHA := CfgVal
  1060.         ELSE IF (CfgVar = 'UNPAK') THEN
  1061.           unPAK := CfgVal
  1062.         ELSE IF (CfgVar = 'UNRAR') THEN
  1063.           unRAR := CfgVal
  1064.         ELSE IF (CfgVar = 'UNUC2') THEN
  1065.           unUC2 := CfgVal
  1066.         ELSE IF (CfgVar = 'UNZIP') THEN
  1067.           unZIP := CfgVal
  1068.         ELSE IF (CfgVar = 'UNZOO') THEN
  1069.           unZOO := CfgVal
  1070.       END;
  1071.     END; { loop back to read another line }
  1072.     Close (CfgFile);
  1073.   END;
  1074. END;
  1075. {===========================================================================}
  1076.  
  1077. FUNCTION IsArchive (CONST SomeFile: PATHSTR): PATHSTR;
  1078. VAR
  1079.   ExCMD : PATHSTR;
  1080.   ExWord: NAMESTR;
  1081.   FileID : ARCTYPE;
  1082. BEGIN
  1083.   ExCMD := '';
  1084.   FileID := IsArc (SomeFile);
  1085.   IF FileID <> NONE THEN BEGIN
  1086.  
  1087.      IF FileID = ARC THEN ExCMD := unARC ELSE
  1088.      IF FileID = ARJ THEN ExCMD := unARJ ELSE
  1089.      IF FileID = LZH THEN ExCMD := unLHA ELSE
  1090.      IF FileID = HAP THEN ExCMD := unHAP ELSE
  1091.      IF FileID = PAK THEN ExCMD := unPAK ELSE
  1092.      IF FileID = RAR THEN ExCMD := unRAR ELSE
  1093.      IF FileID = UC2 THEN ExCMD := unUC2 ELSE
  1094.      IF FileID = ZIP THEN ExCMD := unZIP ELSE
  1095.      IF FileID = ZOO THEN ExCMD := unZOO
  1096.         ELSE
  1097.         BEGIN
  1098.           ExCMD := unQWK;
  1099.         END;
  1100.      IF (Pos (#32, ExCMD) IN [2..9])
  1101.        THEN ExWord := Copy (ExCMD, 1, Pos (#32, ExCMD) - 1)
  1102.        ELSE ExWord := Copy (ExCMD, 1, 8);
  1103.      Write ('(Trying "', ExWord, '") ');
  1104.   END;
  1105.   IsArchive := ExCMD;
  1106. END;
  1107.  
  1108. FUNCTION ExtractFile (CONST ArchiveFile, FileToEx: PATHSTR; ExCMD: PATHSTR): BOOLEAN;
  1109. VAR
  1110.   X, Y, newX: BYTE;
  1111. BEGIN
  1112.   X := WhereX;
  1113.   Y := WhereY;
  1114.   ExCMD := ExCMD + #32 + ArchiveFile + #32 + FileToEx;
  1115.  
  1116. {$IFDEF DPMI}
  1117.   SwapVectors;
  1118.     Exec (GetEnv ('COMSPEC'), ' /c '+ExCMD+' >nul');
  1119.   SwapVectors;
  1120. {$ELSE}
  1121.   DosError := HeapMan. Execute (GetEnv ('COMSPEC'), ' /c '+ExCMD+' >nul');
  1122. {$ENDIF}
  1123.  
  1124.   newX := WhereX;
  1125.   IF (Y = WhereY) and (WhereX >= newX) THEN
  1126.   BEGIN  {If we haven't moved to a new line... }
  1127.     GotoXY (X, Y);  {return to where we were at start of procedure}
  1128.     ClrEol;
  1129.   END;
  1130.   cursorOff;
  1131.   ExtractFile := IsFile (FileToEx)
  1132. END;
  1133. {===========================================================================}
  1134.  
  1135. BEGIN
  1136.   cursorOff;
  1137.   InitConfig;
  1138. END.
  1139.